#!/usr/bin/perl
#
# Tool for manipulating the places table
# Typically used for entering population number updates
#
# Options:
# -l [place] - list all places [starting with place]
# -u [file] - update from file
#   Input file format:
#   First line - field names to update
#   f_key or name is REQUIRED.
#   <number>|<nameid>|<within>|<comment> - verify that this still exists
#    ADD    |
#    DEL    |
# This file format is the same as produced with -l.
#
use Counter;
use Fcntl;
use strict;
use Getopt::Long;
use vars qw($usage $mode $target $file $DEBUG $popfix);

$popfix = 0;

$usage = "Usage: $0 [-l [area]] [-u file]\n";

do {
    my $list;
    my $update;
    my $check;

    GetOptions("list|l" => \$list,
	       "update|u" => \$update,
	       "check|c" => \$check,
	       "populationfix" => \$popfix,
	       "debug" => \$DEBUG,
	       );

    if ($list) {
	$mode = "list";
    } elsif ($check) {
	$mode = "check";
    } elsif ($update) {
	$mode = "update";
    } else {
	die $usage;
    }
};

if ($mode eq "check") {
    warn "Checking changes from file\n";
    updateplaces(0);
} elsif ($mode eq "update") {
    warn "Updating from file\n";
    updateplaces(1);
} elsif ($mode eq "list") {
    $target = shift;
    if ($target) {
        warn "Listing under $target\n";
    } else {
	warn "Listing all\n";
    }
    listplaces($target);
} else {
    die $usage;
}

sub listplaces {
    my $target = shift;
    my @entries;
    my $within;
    my $entry;

    $file = FileTable::open("db/places");
    # DOES NOT WORK YET
    die "This is still only listing aliases, and not using recursion\n";
    if (defined($target)) {
	@entries = $file->select("type = 'alias' and name like '$target%'");
    } else {
	@entries = $file->select("type = 'alias'");
    }
    for $entry (@entries) {
	$within = $file->get($entry->{within});
	print $entry->key, "|", $entry->{name}, "|", 
	$within->{name}, "|", $entry->{longname}, "\n";
    }
}

sub updateplaces {
    my $doit = shift;

    if ($doit) {
	$file = FileTable::open("db/places", O_RDWR);
    } else {
	$file = FileTable::open("db/places");
    }	
    my $changes = 0;
    my $wasdone = 0;
    my $checks = 0;
    my $problems = 0;
    my @fieldlist;

    do {
	my $foundkey;
	my $foundname;
	my $fieldlist;
	my $field;
	# Read file header
	$_ = <>;
	chop;
	@fieldlist = split(/\t|\|/);
	for $field (@fieldlist) {
	    $foundkey = 1 if $field eq "f_key";
	    $foundname = 1 if $field eq "name";
	}
	die "Neither name nor f_key in header\n"
	    if !$foundkey && !$foundname;
	$DEBUG && warn "Fields are ", join(" ", @fieldlist), "\n";
    };

  line:
    while (<>) {
	my %newrec;
	my @fields;

	chop;
	next if /^\s*#/; # comment
	next if /^\s*$/; # empty line
	@fields = split(/\t|\|/);
	if ($#fields != $#fieldlist) {
	    warn "Number of fields is ", @fields+0, " not ", @fieldlist+0, ", skipping\n";
	    $DEBUG && warn join("|", @fields), "\n";;
	    next;
	}
	my $ix;
	for $ix (0..$#fields) {
	    if ($fieldlist[$ix] eq "population" && $popfix) {
		$newrec{$fieldlist[$ix]} = $fields[$ix] / 1000000;
		$DEBUG && warn "Population $fields[$ix] reduced to $newrec{$fieldlist[$ix]}\n";
	    } else {
		$newrec{$fieldlist[$ix]} = $fields[$ix];
	    }
	} 
	
	# - N records must NOT exist, and MUST have name
	if ($newrec{f_key} eq "N") {
	    my $within;
	    if (!$newrec{name}) {
		warn "N record with no name - skip\n";
		next;
	    }
	    if (!$newrec{within}) {
		warn "N record with no within - skip\n";
		$DEBUG && warn join(" ", %newrec);
		next;
	    } else {
		$within = getwithin($newrec{within});
		if (!$within) {
		    warn "N record with within that does not exist - skip\n";
		    next;
		}
	    }
		
	    my $rec = $file->getbykey("name", $newrec{name});
	    if ($rec) {
		warn "N record $newrec{name}: Already in DB - skip\n";
		next;
	    }
	    print "Creating record $newrec{name}\n";
	    if ($doit) {
		my $rec = $file->newnum();
		my $key;
		for $key (keys(%newrec)) {
		    if ($key eq "within") {
			$$rec{$key} = $within->key();
		    } elsif ($key ne "f_key") {
			$$rec{$key} = $newrec{$key};
		    }
		}
		$rec->store();
	    }
	} elsif ($newrec{f_key} eq "D") {
	    my $rec = $file->getbykey("name", $newrec{name});
	    if (!$rec) {
		warn "Delete - $newrec{name} does not exist\n";
		next;
	    }
	    my @children = $file->select("within = ?", $rec->key());
	    if (@children+0) {
		warn "Delete - place has children. No delete\n";
		next;
	    }
	    print "Deleting record $newrec{name}\n";
	    if ($doit) {
		$rec->delete();
	    }
	} else {
	    # Update
	    my $rec;
	    my $accesskey;
	    if ($newrec{f_key}) {
		$accesskey = $newrec{f_key};
		$rec = $file->get($newrec{f_key});
	    } else {
		$accesskey = $newrec{name};
		$rec = $file->getbykey("name", $newrec{name});
	    }
	    if (!$rec) {
		warn "$accesskey update: No record\n";
		next;
	    }
	    if ($newrec{name} && lc($rec->{name}) ne lc($newrec{name})) {
		warn "$accesskey update: Name change - skip\n";
		next;
	    }
	    my $key;
	    for $key (keys(%newrec)) {
		if ($key eq "within") {
		    my $within = getwithin($newrec{within});
		    if (!$within) {
			warn "Update: Within not found\n";
			next line;
		    }
		    $$rec{$key} = $within->key();
		} elsif ($key ne "f_key") {
		    $$rec{$key} = $newrec{$key};
		}
	    }
	    print "Updating record ", $rec->key(), " $$rec{name}\n";
	    if ($doit) {
		$rec->store();
	    }
	}
    }
}


	    
sub getwithin {
    my $id = shift;
    my $within;
    if ($id =~  /^\d+$/) {
	$within = $file->get($id);
    } else {
	$within = $file->getbykey("name", $id);
    }
    return $within;
}
		
	    
